home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
msortp.zip
/
TMSORTP.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1993-02-02
|
8KB
|
287 lines
{===================================================================
TMSORTP - a test program for the MSORTP unit
Call with 5 command line parameters as follows:
TMSORTP ElsToSort MemToUse MinSize MaxSize SizeStep
where
ElsToSort is the number of elements to sort
MemToUse is the maximum bytes of heap space for the sort to use
MinSize is the smallest element size to test in bytes
MaxSize is the largest element size to test
SizeStep is the number of bytes to step between tests
The smallest acceptable value for MinSize is 4. The largest
acceptable value for MaxSize is 40000. (This can be increased for
DPMI and real mode apps, where the stack and global data don't share
the same data.)
TMSORTP reports the most interesting results from the MergeInfo
procedure -- number of merge files, number of merge phases, peak disk
space, actual amount of heap used -- as well as the results of the
OptimumHeapToUse and MinimumHeapToUse functions. Then it performs the
sort.
TMSORTP sorts records that start with a 4-byte LongInt key, followed
by a zero-filled variable length array to make up the rest of the
record.
If the Time symbol is defined below, and the OPTIMER unit is
available (from the OPRO bonus disk, from CompuServe, or from the
TurboPower BBS), and the program is being run from DPMI or real mode
DOS (as opposed to Windows), TMSORTP times the sort and reports the
time in milliseconds.
If TestAccuracy is defined below, TMSORTP checks the results of the
sort for accuracy. It assures that each sorted element is greater
than or equal to the previous element, that the correct number of
sorted elements is returned, that the checksum of the sorted elements
is the same as the checksum of the original elements, and that the
tail of each sorted record contains correct data.
If Sequential is defined below, the LongInt keys are created in
sequential order, with the result that the sort engine is sorting an
already sorted group of records. (This is actually a worst-case for a
plain quick sort algorithm, although MSORTP takes measures to defeat
this worst case). If Sequential is not defined, the LongInt keys are
a random sequence generated by Turbo Pascal's Random function.
See MSORTP.DOC for more information about using the MSORTP unit.
===================================================================}
{$IFNDEF Windows}
{$DEFINE Time} {Define to time the sorts}
{$ENDIF}
{$DEFINE TestAccuracy} {Define to test the accuracy of the sorts}
{.$DEFINE Sequential} {Define to test sort of a sorted list}
{$R-,S-,X+}
program TMSortP;
{-Test/demo program for MSORTP unit}
uses
{$IFDEF Windows}
WinCrt,
{$ELSE}
Crt,
{$ENDIF}
{$IFDEF Time}
OpTimer,
{$ENDIF}
MSortP;
const
AbsMaxElSize = 40000; {Largest element we can test}
type
ElementType =
record
case Byte of
0 : (Key : LongInt);
1 : (Data : array[1..AbsMaxElSize] of Byte);
end;
var
ElsToSort : LongInt;
MemToUse : LongInt;
MinElSize : Word;
MaxElSize : Word;
ElSizeStep : Word;
ElSize : Word;
Status : Word;
CmpStatus : Word;
BytesAtEnd : Word;
MI : MergeInfoRec;
{$IFDEF Time}
T1 : LongInt;
T2 : LongInt;
{$ENDIF}
DataRec : ElementType;
{$IFDEF TestAccuracy}
CheckSum : LongInt;
{$ENDIF}
procedure SendToSortEngine; far;
var
I : LongInt;
begin
FillChar(DataRec, SizeOf(ElementType), 0);
{$IFDEF Time}
T1 := ReadTimer;
{$ENDIF}
{$IFDEF TestAccuracy}
CheckSum := 0;
{$ENDIF}
for I := 1 to ElsToSort do begin
{$IFDEF Sequential}
DataRec.Key := I;
{$ELSE}
DataRec.Key := LongInt(Random(32767))*Random(32767);
{$ENDIF}
{$IFDEF TestAccuracy}
move(DataRec.Key, DataRec.Data[ElSize-BytesAtEnd+1], BytesAtEnd);
inc(CheckSum, DataRec.Key);
{$ENDIF}
if not PutElement(DataRec) then
Exit;
end;
end;
procedure GetFromSortEngine; far;
var
Count : LongInt;
Last : LongInt;
EndCheck : LongInt;
StartCheck : LongInt;
TestSum : LongInt;
begin
Count := 0;
Last := -1;
{$IFDEF TestAccuracy}
TestSum := 0;
{$ENDIF}
while GetElement(DataRec) do begin
{$IFDEF TestAccuracy}
inc(Count);
{$IFDEF Sequential}
if DataRec.Key <> Count then begin
WriteLn;
WriteLn('Sort error!!! Count:', Count, ' Data:', DataRec.Key);
CmpStatus := 9999;
Exit;
end;
{$ELSE}
if DataRec.Key < Last then begin
WriteLn;
WriteLn('Sort error!!! Count:', Count, ' Data:', DataRec.Key, ' Last:', Last);
CmpStatus := 9999;
Exit;
end;
Last := DataRec.Key;
{$ENDIF}
StartCheck := 0;
move(DataRec.Key, StartCheck, BytesAtEnd);
EndCheck := 0;
move(DataRec.Data[ElSize-BytesAtEnd+1], EndCheck, BytesAtEnd);
if EndCheck <> StartCheck then begin
WriteLn;
WriteLn('Storage error!!! Count:', Count);
CmpStatus := 9998;
Exit;
end;
inc(TestSum, DataRec.Key);
{$ENDIF}
end;
{$IFDEF TestAccuracy}
if Count <> ElsToSort then begin
WriteLn;
WriteLn('Count error!!!');
CmpStatus := 9997;
end;
if TestSum <> CheckSum then begin
WriteLn;
WriteLn('Checksum error!!!');
CmpStatus := 9997;
end;
{$ENDIF}
{$IFDEF Time}
T2 := ReadTimer;
{$ENDIF}
end;
function CompareElements(var X, Y) : Boolean; far;
begin
CompareElements := (ElementType(X).Key < ElementType(Y).Key);
end;
function GetLong(OptName, S : String; Min, Max : LongInt) : LongInt;
var
L : LongInt;
Code : Word;
begin
Val(S, L, Code);
if Code <> 0 then begin
WriteLn(OptName, ' invalid: "', S, '"');
Halt;
end;
if (L < Min) or (L > Max) then begin
WriteLn(OptName, ' out of range ', Min, '..', Max, ': "', S, '"');
Halt;
end;
GetLong := L;
end;
begin
if ParamCount <> 5 then begin
WriteLn('Usage: TMSORTP ElsToSort MemToUse MinSize MaxSize SizeStep');
Halt;
end;
ElsToSort := GetLong('ElsToSort', ParamStr(1), 2, MaxLongInt);
MemToUse := GetLong('MemToUse', ParamStr(2), 1, MaxLongInt);
MinElSize := GetLong('MinSize', ParamStr(3), 4, AbsMaxElSize);
MaxElSize := GetLong('MaxSize', ParamStr(4), 4, AbsMaxElSize);
ElSizeStep := GetLong('SizeStep', ParamStr(5), 1, AbsMaxElSize);
{$IFNDEF Windows}
Assign(Output, '');
Rewrite(Output);
{$ENDIF}
WriteLn('ElsToSort ', ElsToSort);
WriteLn('MemToUse ', MemToUse);
WriteLn;
{ssssss ffff ppppp ddddddd hhhhhhh ooooooo mmmmmmm tttttt}
Write('ElSize Files Phases Disk Heap OptHeap MinHeap');
{$IFDEF Time}
Write(' Time');
{$ENDIF}
WriteLn;
ElSize := MinElSize;
while ElSize <= MaxElSize do begin
MergeInfo(MemToUse, ElSize, ElsToSort, MI);
Write(ElSize:6, ' ',
MI.MergeFiles:4, ' ',
MI.MergePhases:5, ' ',
MI.MaxDiskSpace:7, ' ',
MI.HeapUsed:7, ' ',
OptimumHeapToUse(ElSize, ElsToSort):7, ' ',
MinimumHeapToUse(ElSize):7, ' ');
if MI.SortStatus <> 0 then begin
WriteLn('Status = ', MI.SortStatus);
Halt;
end;
RandSeed := 0;
CmpStatus := 0;
{$IFDEF TestAccuracy}
BytesAtEnd := ElSize-4;
if BytesAtEnd > 4 then
BytesAtEnd := 4;
{$ENDIF}
Status := MergeSort(MemToUse, ElSize,
SendToSortEngine,
CompareElements,
GetFromSortEngine,
DefaultMergeName);
if CmpStatus <> 0 then begin
WriteLn(' Bug ', CmpStatus);
Halt;
end;
if Status <> 0 then begin
WriteLn(' Failure ', Status);
Halt;
end;
{$IFDEF Time}
Write(ElapsedTime(T1, T2):6:0);
{$ENDIF}
WriteLn;
if KeyPressed then begin
ReadKey;
Halt;
end;
inc(ElSize, ElSizeStep);
end;
end.